home *** CD-ROM | disk | FTP | other *** search
/ HyperLib 1997 Winter - Disc 1 / HYPERLIB-1997-Winter-CD1.ISO.7z / HYPERLIB-1997-Winter-CD1.ISO / オンラインウェア / PRG / ICProgKit 1.3.sit / ICProgKit1.3 / Goodies / ICeTEe / ShowInit-75.p < prev    next >
Text File  |  1995-05-01  |  8KB  |  248 lines
  1. unit ShowInit75;
  2.  
  3. interface
  4.  
  5. {$ifc undefined THINK_Pascal}
  6.     uses
  7.         Types;
  8. {$endc}
  9.  
  10. { --------------------------------------------------------------------------------------------------------------------- }
  11. { Set this to 1 if you want to compile ShowInit-7 into a stand-alone resource. I don't recommend it; see notes below. }
  12.  
  13.     procedure ShowIcon7 (iconFamilyID: integer; advance: Boolean);
  14.  
  15. implementation
  16.  
  17. { ShowInit-7 - version 1.0.4, April 25th, 1995 }
  18. { This code is intended to let INIT writers easily display an icon at startup time. }
  19.  
  20. { I have found that there are many snippets out there showing how to do this, but all of those I tried were  }
  21. { unnecessarily complex and/or had bugs. I would like to make widely available a version that is as simple  }
  22. { and bug-free as possible. If you feel that this code needs enhancements, please let me know so that I can roll them in. }
  23.  
  24. { This version features: }
  25. { - Short and readable code. }
  26. { - Correctly wraps around when more than one row of icons has been displayed. }
  27. { - works with System 6 }
  28. { - Built with Universal Headers & CodeWarrior. Slight changes should suffice to accommodate other headers/compilers. }
  29.  
  30. { Written by Fran腔is Pottier (pottier@clipper.ens.fr), with thanks to the numerous authors I stole code from. }
  31. { This code is free for use in any project. }
  32.  
  33. { Hacked by Peter N Lewis <peter@mail.peter.com.au>.  I mostly just merged in some of  }
  34. { Jim Walker's <JWWalker@aol.com> code. }
  35.  
  36. { --------------------------------------------------------------------------------------------------------------------- }
  37.  
  38. { Version History: }
  39. { 1.0: }
  40. {    Initial release }
  41. { 1.0.1: }
  42. {    Added qdGlobalsPtr for QuickDraw to store a pointer into. I hadn't seen this bug because it didn't crash a Power Mac! }
  43. { 1.0.2: }
  44. {    Added a C equivalent for CheckSum. }
  45. {    Fixed a problem which would prevent the icon from displaying when Conflict Catcher is present. }
  46. { 1.0.3: }
  47. {    Now checks for the required system functionality and does nothing if absent. }
  48. { 1.0.4: }
  49. {    Added STANDALONE preprocessor flag to allow separate compilation. }
  50. {    Changed calling convention to 'Pascal' so that people without a C compiler could use it. }
  51. { 1.1.0: }
  52. {  Support System 6 trivial, and support the advance boolean, removed the asm code - PNL }
  53. {  Basically, added the good features of ShowIcon7 to this in a hopeless attempt to }
  54. {  make ShowInit the "One True Show Icon Code". }
  55.  
  56.     uses
  57. {$ifc undefined THINK_Pascal}
  58.         OSUtils, Resources, Memory, QuickDraw, 
  59. {$endc}
  60.         Icons;
  61.  
  62. { --------------------------------------------------------------------------------------------------------------------- }
  63. { The ShowINIT mechanism works by having each INIT read/write data from these globals. }
  64.  
  65.     type
  66.         LMShowInitRecord = packed record
  67.                 LMVCheckSum: integer;
  68.                 LMVCoord: integer;
  69.                 LMHCoord: integer;
  70.                 LMHCheckSum: integer;
  71.             end;
  72.         LMShowInitRecordPtr = ^LMShowInitRecord;
  73.  
  74.     const
  75.         LMShowInitRecordAddr = $928; { Low Memory address of record }
  76.  
  77. { prototypes }
  78.     function CheckSum (x: integer): integer;
  79.     forward;
  80.     procedure ComputeIconRect (var iconRect: Rect; var bounds: Rect);
  81.     forward;
  82.     procedure AdvanceIconPosition (var iconRect: Rect);
  83.     forward;
  84.     procedure DrawBWIcon (iconId: integer; var icon_rect: Rect; visible: Boolean);
  85.     forward;
  86.  
  87. { --------------------------------------------------------------------------------------------------------------------- }
  88. { Main routine. }
  89. { This must be the first routine for THINK C's "Custom Header" option to work }
  90.  
  91. {$ifc not undefined THINK_Pascal}
  92.     type
  93.         QDGlobals = record
  94.                 privates: packed array[0..75] of CHAR;
  95.                 randSeed: LONGINT;
  96.                 screenBits: BitMap;
  97.                 arrow: Cursor;
  98.                 dkGray: Pattern;
  99.                 ltGray: Pattern;
  100.                 gray: Pattern;
  101.                 black: Pattern;
  102.                 white: Pattern;
  103.                 thePort: GrafPtr;
  104.             end;
  105.     type
  106.         IconAlignmentType = integer;
  107.         IconTransformType = integer;
  108.  
  109.     const
  110.         ttNone = $0;
  111.         atNone = $0;
  112.  
  113.     function PlotIconID (var theRect: Rect; align: IconAlignmentType; transform: IconTransformType; theResID: INTEGER): OSErr;
  114.     inline
  115.         $303C, $0500, $ABC9;
  116.  
  117. {$endc}
  118.  
  119.     type
  120.         QDStorage = record
  121.                 qd: QDGlobals;                            { Storage for the QuickDraw globals }
  122.                 qdGlobalsPtr: Ptr;                        { A5 points to this place; it will contain a pointer to qd }
  123.             end;
  124.  
  125.     procedure ShowIcon7 (iconFamilyID: integer; advance: Boolean);
  126.         var
  127.             oldA5: longInt;
  128.             qds: QDStorage;                            { Fake QD globals }
  129.             colorPort: CGrafPort;
  130.             bwPort: GrafPort;
  131.             destRect: Rect;
  132.             environment: SysEnvRec;                { machine configuration. }
  133.             junk: OSErr;
  134.     begin
  135.  
  136.         oldA5 := SetA5(longInt(@qds.qdGlobalsPtr));                    { Tell A5 to point to the end of the fake QD Globals }
  137.         InitGraf(@qds.qd.thePort);                            { Initialize the fake QD Globals }
  138.  
  139.         { find out what kind of machine this is. }
  140.         junk := SysEnvirons(curSysEnvVers, environment);
  141.  
  142.         ComputeIconRect(destRect, qds.qd.screenBits.bounds);        { Compute where the icon should be drawn }
  143.  
  144.         if (environment.systemVersion >= $0700) & environment.hasColorQD then begin
  145.             OpenCPort(@colorPort);
  146.             DrawBWIcon(iconFamilyID, destRect, false);
  147.             junk := PlotIconID(destRect, atNone, ttNone, iconFamilyID);
  148.             CloseCPort(@colorPort);
  149.         end
  150.         else begin
  151.             OpenPort(@bwPort);
  152.             DrawBWIcon(iconFamilyID, destRect, true);
  153.             ClosePort(@bwPort);
  154.         end;
  155.  
  156.         if advance then begin
  157.             AdvanceIconPosition(destRect);
  158.         end;
  159.  
  160.         oldA5 := SetA5(oldA5);                                         { Restore A5 to its previous value }
  161.     end;
  162.  
  163. { --------------------------------------------------------------------------------------------------------------------- }
  164. { A checksum is used to make sure that the data in there was left by another ShowINIT-aware INIT. }
  165.  
  166.     function CheckSum (x: integer): integer;            { This is the shortest C equivalent I could find. }
  167.     begin
  168.         CheckSum := BXOR(BOR(BSL(x, 1), BSR(x, 15)), $1021);
  169.     end;
  170.  
  171. { --------------------------------------------------------------------------------------------------------------------- }
  172. { Compute where the icon should be displayed and update the shared globals. }
  173.  
  174.     procedure ComputeIconRect (var iconRect: Rect; var bounds: Rect);
  175.         var
  176.             lmp: LMShowInitRecordPtr;
  177.     begin
  178.         lmp := LMShowInitRecordPtr(LMShowInitRecordAddr);
  179.         if (CheckSum(lmp^.LMHCoord) <> lmp^.LMHCheckSum) then begin                { If we are first, we need to initialize the shared data. }
  180.             lmp^.LMHCoord := 8;
  181.         end;
  182.         if (CheckSum(lmp^.LMVCoord) <> lmp^.LMVCheckSum) then begin
  183.             lmp^.LMVCoord := bounds.bottom - 40;
  184.         end;
  185.  
  186.         if (lmp^.LMHCoord + 34 > bounds.right) then begin                { Check whether we must wrap }
  187.             iconRect.left := 8;
  188.             iconRect.top := lmp^.LMVCoord - 40;
  189.         end
  190.         else begin
  191.             iconRect.left := lmp^.LMHCoord;
  192.             iconRect.top := lmp^.LMVCoord;
  193.         end;
  194.         iconRect.right := iconRect.left + 32;
  195.         iconRect.bottom := iconRect.top + 32;
  196.     end;
  197.  
  198.     procedure AdvanceIconPosition (var iconRect: Rect);
  199.         var
  200.             lmp: LMShowInitRecordPtr;
  201.     begin
  202.         lmp := LMShowInitRecordPtr(LMShowInitRecordAddr);
  203.         lmp^.LMHCoord := iconRect.left + 40;                        { Update the shared data }
  204.         lmp^.LMVCoord := iconRect.top;
  205.         lmp^.LMHCheckSum := CheckSum(lmp^.LMHCoord);
  206.         lmp^.LMVCheckSum := CheckSum(lmp^.LMVCoord);
  207.     end;
  208.  
  209. { DrawBWIcon() draws the 'ICN#' member of the icon family. }
  210.  
  211.     procedure DrawBWIcon (iconId: integer; var icon_rect: Rect; visible: Boolean);
  212.         var
  213.             icon: Handle;
  214.             source, destination: BitMap;
  215.             empty_mask: RgnHandle;
  216.             port: GrafPtr;
  217.     begin
  218.         icon := Get1Resource('ICN#', iconId);
  219.         if (icon <> nil) then begin
  220.             HLock(icon);
  221.  
  222.             { prepare the source and destination bitmaps. }
  223.             source.baseAddr := Ptr(longInt(icon^) + 128);                    { mask address. }
  224.             source.rowBytes := 4;
  225.             SetRect(source.bounds, 0, 0, 32, 32);
  226.             GetPort(port);
  227.             destination := port^.portBits;
  228.             if visible then begin
  229.                 empty_mask := nil;
  230.             end
  231.             else begin
  232.                 empty_mask := NewRgn;
  233.             end;
  234.  
  235.             { transfer the mask. }
  236.             CopyBits(source, destination, source.bounds, icon_rect, srcBic, empty_mask);
  237.  
  238.             { and the icon. }
  239.             source.baseAddr := icon^;
  240.             CopyBits(source, destination, source.bounds, icon_rect, srcOr, empty_mask);
  241.  
  242.             if (empty_mask <> nil) then begin
  243.                 DisposeRgn(empty_mask);
  244.             end;
  245.         end;
  246.     end;
  247.  
  248. end.